home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbapg.arc / FORMGEN.PRG < prev    next >
Encoding:
Text File  |  1984-08-12  |  15.1 KB  |  502 lines
  1. * Program.: FORMGEN.PRG
  2. * Author..: Luis A. Castro & Roy M. Moore
  3. * Date....: 7/11/83
  4. * Notice..: Copyright 1983, Ashton-Tate, All Rights Reserved
  5. * Version.: dBASE II, version 2.4x
  6. * Notes...: Generates a command file which prints reports
  7. *           similar to the REPORT FORM command.
  8. *           Includes subtotaling and totaling.
  9. * Local...: equals, y:n, extension, datafile, formfile,
  10. *           lmargin, pagelen, pagewidth, pagehdg, string,
  11. *           issubtotal, totstack, substack, subfield,
  12. *           Mcontents, Mwidth, option, item, prompt,
  13. *           yourname, totalopts, stackcount, heading,
  14. *           width, istotal, col
  15. *
  16. CLEAR
  17. SET TALK OFF
  18. STORE ".PRG" TO extension
  19. STORE "Your Name" TO yourname
  20. STORE "N" TO y:n
  21. STORE "========================================" +;
  22.       "========================================" TO equals
  23. * ---Macros to determine WIDTH & CONTENTS of values entered.
  24. STORE [VAL($(option&item,1,@(",",option&item)-1))] TO Mwidth
  25. STORE [option&item,@(",",option&item)+1,] +;
  26.       [LEN(option&item)-@(",",option&item)] TO Mcontents
  27. *
  28. * ---Open datafile name.
  29. ERASE
  30. @ 2, 0 SAY "REPORT  FORM  program  generator"
  31. @ 2,72 SAY DATE()
  32. @ 3, 0 SAY "========================================"
  33. @ 3,40 SAY "========================================"
  34. ACCEPT "Enter DATABASE filename " TO datafile
  35. STORE !( TRIM(datafile) ) + "." TO datafile
  36. STORE $( datafile, 1, @(".",datafile) - 1 ) TO datafile
  37. DO CASE
  38.    CASE datafile = " "
  39.       ERASE
  40.       CLEAR
  41.       SET TALK ON
  42.       RETURN
  43.    CASE .NOT. FILE( datafile + ".DBF" )
  44.       ? "FILE DOES NOT EXIST"
  45.       CLEAR
  46.       SET TALK ON
  47.       RETURN
  48. ENDCASE
  49. USE &datafile
  50. *
  51. * ---Get REPORT FORM filename.
  52. ACCEPT "Enter REPORT FORM filename " TO formfile
  53. STORE !( TRIM( formfile ) ) + "." TO formfile
  54. STORE $( formfile, 1, @(".",formfile) - 1 ) TO formfile
  55. DO CASE
  56.    CASE formfile = " "
  57.       ERASE
  58.       CLEAR
  59.       SET TALK ON
  60.       RETURN
  61.    CASE FILE( formfile + extension )
  62.       * ---Command file already exists.
  63.       SET BELL OFF
  64.       STORE "N" TO select
  65.       @ 7,0 SAY "COMMAND FILE ALREADY EXISTS.   " +;
  66.                 "Delete it? (Y/N) ";
  67.             GET select PICTURE "!"
  68.       READ
  69.       SET BELL ON
  70.       @ 7,0 SAY "C"
  71.       IF select <> "Y"
  72.          CLEAR
  73.          SET TALK ON
  74.          RETURN
  75.       ENDIF
  76. ENDCASE
  77. STORE formfile + extension TO formfile
  78. *
  79. * ---Enter REPORT FORM parameters.
  80. ?
  81. ? "ENTER OPTIONS:"
  82. ACCEPT "   Left Margin...<1>." TO lmargin
  83. ACCEPT "   Lines/Page...<56>." TO pagelen
  84. ACCEPT "   Page Width...<80>." TO pagewidth
  85. * ---Set to default values if null entries.
  86. IF VAL(lmargin) = 0
  87.    STORE "1" TO lmargin
  88. ENDIF
  89. IF VAL(pagelen) = 0
  90.    STORE "56" TO pagelen
  91. ENDIF
  92. IF VAL(pagewidth) = 0
  93.    STORE "80" TO pagewidth
  94. ENDIF
  95. ?
  96. ACCEPT "Enter Page Heading." TO pagehdg
  97. ACCEPT "Are Totals Required? (Y/N) " TO string
  98. STORE @( string, "Yy" ) > 0 TO istotal
  99. ACCEPT "Subtotals in Report? (Y/N) " TO string
  100. STORE @( string, "Yy" ) > 0 TO issubtotal
  101. *
  102. * ---Set up environment for totaling.
  103. STORE " " TO totstack,substack
  104. IF issubtotal
  105.    STORE 1 TO counter
  106.    STORE " " TO subfield
  107.    DO WHILE subfield = " " .AND. counter <= 3
  108.       ACCEPT "Enter subtotal field" TO subfield
  109.       STORE !(subfield) TO subfield
  110.       IF 0 = TEST(&subfield)
  111.       * ---If subfield not in the datafile.
  112.          STORE " " TO subfield
  113.       ENDIF
  114.       STORE counter + 1 TO counter
  115.    ENDDO
  116.    IF counter > 3
  117.       CLEAR
  118.       SET TALK ON
  119.       RETURN
  120.    ENDIF
  121. ENDIF
  122. ?
  123. * ---Enter REPORT FORM Width,Contents.
  124. ? "ENTER COLUMN DESCRIPTORS:"
  125. *
  126. * ---Loop through until a carriage return
  127. * ---or more than 12 options are entered.
  128. STORE "11" TO item
  129. STORE "X" TO option&item
  130. DO WHILE option&item <> " " .AND. VAL( item ) <= 22
  131.    STORE STR( VAL(item)-10, 2 ) + ". Width,Contents." TO prompt
  132.    ACCEPT "&prompt" TO option&item
  133.    STORE $(&Mcontents) TO string
  134.    IF @(",",option&item) > 3 .OR. @(",",option&item) = 0 .OR.;
  135.       option&item = " " .OR. 0 = TEST(&string) 
  136.       * ---Syntax error in input, or exit.
  137.       * ---The TEST() function will return 0,
  138.       * ---if the contents cannot be parsed.
  139.       LOOP
  140.    ENDIF
  141.    IF TYPE(&string)="L"
  142.       * ---Logicals are not accepted.
  143.       LOOP
  144.    ENDIF
  145.    ACCEPT "    Heading........" TO heading&item
  146.    IF LEN(heading&item) > &Mwidth
  147.       STORE $(heading&item,1,&Mwidth) TO heading&item
  148.    ENDIF
  149.    * ---See if field entered is numeric, so as to inquire
  150.    * ---about totaling and/or subtotaling for this field.
  151.    * ---The TEST() function will always return a negative
  152.    * ---number on numeric fields or numeric memory variables.
  153.    IF 0 > TEST(&string) .AND. istotal
  154.       ACCEPT "    Totals? (Y/N)" TO y:n
  155.       IF !(y:n) = "Y"
  156.          STORE totstack + "&item" TO totstack
  157.       ENDIF
  158.    ENDIF
  159.    IF 0 > TEST(&string) .AND. issubtotal
  160.       ACCEPT "    Subtotals? (Y/N)" TO y:n
  161.       IF !(y:n) = "Y"
  162.          STORE substack + "&item" TO substack
  163.       ENDIF
  164.    ENDIF
  165.    ?
  166.    STORE STR( VAL( item ) + 1, 2 ) TO item
  167.    STORE "X" TO option&item
  168. ENDDO
  169. STORE VAL( item ) - 1 TO totalopts
  170. IF option11=" "
  171.    CLEAR
  172.    SET TALK ON
  173.    RETURN
  174. ENDIF
  175. *
  176. * ---Create a temporary structure file to 
  177. * ---determine field LEN and DEC for numerics.
  178. COPY STRUCTURE EXTENDED TO &datafile..$$$ 
  179. USE &datafile..$$$
  180. *
  181. * ---Generate REPORT FORM file.
  182. ERASE
  183. SET RAW ON
  184. SET ALTERNATE TO &formfile
  185. SET ALTERNATE ON
  186. ? [* Program.: ] + formfile
  187. ? [* Author..: ] + yourname
  188. ? [* Date....: ] + DATE()
  189. ? [* Notice..: Copyright 19] + $( DATE(), 7, 2 ) +;
  190.                 [, All Rights Reserved]
  191. ? [* Local...: pagenum, line, pagehdg, col:hdg, condition,]
  192. ? [*           lastrec]
  193. ? [*]
  194. ? [SET TALK OFF]
  195. ? [SET BELL OFF]
  196. ? [SET MARGIN TO ] + lmargin
  197. ? [STORE 1 TO pagenum]
  198. ? [STORE 254 TO line]
  199. ? [STORE "] + pagehdg + [" TO pagehdg]
  200. ? [STORE ( ] + pagewidth + [ - LEN( pagehdg ) ) / 2 TO col:hdg]
  201. STORE "11" TO item
  202. IF istotal .AND. LEN(totstack) <> 1
  203.    ? [*]
  204.    ? [* ---Initialize accumulators.]
  205.    STORE $( totstack, 2, LEN( totstack ) ) TO totstack
  206.    STORE "11" TO item
  207.    STORE   1  TO stackcount
  208.    DO WHILE stackcount < LEN( totstack )
  209.       IF item = $( totstack, stackcount, 2 )
  210.          ? [STORE 0 TO total&item]
  211.          STORE stackcount + 2 TO stackcount
  212.       ENDIF
  213.       STORE STR( VAL( item ) + 1, 2 ) TO item
  214.    ENDDO
  215. ENDIF
  216. IF issubtotal .AND. LEN(substack) <> 1
  217.    STORE $( substack, 2, LEN( substack ) ) TO substack
  218.    STORE "11" TO item
  219.    STORE 1 TO stackcount
  220.    DO WHILE stackcount < LEN( substack )
  221.       IF item = $( substack, stackcount, 2 )
  222.          ? [STORE 0 TO subtot&item]
  223.          STORE stackcount + 2 TO stackcount
  224.       ENDIF
  225.       STORE STR( VAL( item ) + 1, 2 ) TO item
  226.    ENDDO
  227. ENDIF
  228. ? [*]
  229. ? [* ---Open the datafile and print the report.]
  230. ? [USE ] + datafile
  231. ? [ERASE]
  232. ? [@ 2, 0 SAY pagehdg]
  233. ? [@ 2,72 SAY DATE()]
  234. ? [@ 3, 0 SAY "========================================"]
  235. ? [@ 3,40 SAY "========================================"]
  236. ? [STORE " " TO select]
  237. ? '@ 5,0 SAY "Output to the screen or printer? [S/P] ";'
  238. ? [      GET select PICTURE "!"]
  239. ? [READ]
  240. ? [DO CASE]
  241. ? [   CASE select = "S"]
  242. ? [      ERASE]
  243. ? [      STORE 22 TO pagelen]
  244. ? [   CASE select = "P"]
  245. ? [      SET FORMAT TO PRINT]
  246. ? [      STORE ] + pagelen + [ TO pagelen]
  247. ? [   OTHERWISE]
  248. ? [      ERASE]
  249. ? [      SET BELL ON]
  250. ? [      SET TALK ON]
  251. ? [      RETURN]
  252. ? [ENDCASE]
  253. ? [* ---Enter FOR <expression> for the report, such as,]
  254. ? [* ---STORE "STATE = 'CA'" TO condition]
  255. ? [STORE " " TO condition]
  256. ? [DO WHILE .NOT. EOF]
  257. ? [   IF line > pagelen]
  258. ? [      IF select = "S"]
  259. ? [         ERASE]
  260. ? [      ELSE]
  261. ? [         EJECT]
  262. ? [      ENDIF]
  263. ? [      @ 0,0 SAY "PAGE NO."]
  264. ? [      @ 0,9 SAY STR(pagenum,3)]
  265. ? [      @ 2,col:hdg SAY pagehdg]
  266. ? [      *]
  267. ? [      * ---Generate column headings.]
  268. * ---Provide for proper column spacing.
  269. STORE STR( totalopts, 2 ) TO colcount
  270. DO WHILE VAL( colcount ) >= 11
  271.    STORE "11" TO item
  272.    STORE 0 TO col&colcount
  273.    DO WHILE VAL( colcount ) > VAL( item )
  274.       STORE col&colcount + &Mwidth + 1 TO col&colcount
  275.       STORE STR( VAL( item ) + 1, 2 ) TO item
  276.    ENDDO
  277.    STORE col&colcount + ((VAL(colcount)-11)*2) TO col&colcount
  278.    STORE STR( VAL( colcount ) - 1, 2 ) TO colcount
  279. ENDDO
  280. * ---Generate headings.
  281. STORE "11" TO item
  282. DO WHILE VAL(item) <= totalopts
  283.    ? [      @ 4,] + STR(col&item,3) + [ SAY "]+heading&item+["]
  284.    STORE STR( VAL( item ) + 1, 2 ) TO item
  285. ENDDO
  286. * ---Generate underlining.
  287. STORE "11" TO item
  288. DO WHILE VAL( item ) <= totalopts
  289.    ? [      @ 5,] + STR(col&item,3) + [ SAY "] +;
  290.      $(equals,1,&Mwidth) + ["]
  291.    STORE STR( VAL( item ) + 1, 2 ) TO item
  292. ENDDO
  293. ? [      STORE pagenum + 1 TO pagenum]
  294. ? [      STORE 7 TO line]
  295. ? [   ENDIF]
  296. ? [   * ---Test to see if the condition exists.]
  297. ? [   IF condition <> " "]
  298. ? [      IF .NOT. ( ] + "&" + [condition )]
  299. ? [         SKIP]
  300. ? [         LOOP]
  301. ? [      ENDIF]
  302. ? [   ENDIF]
  303. *
  304. * ---Control break for subtotals.
  305. IF issubtotal .AND. LEN(substack) <> 1
  306.    ? [   IF 0=TEST(lastrec)]
  307.    ? [      * ---Field has not been initialized.]
  308.    ? [      STORE ] + subfield + [ TO lastrec]
  309.    ? [   ENDIF] 
  310.    ? [   *]
  311.    ? [   * ---Print subtotals and reset accumulators]
  312.    ? [   * ---upon control break.]
  313.    ? [   IF lastrec <> ] + subfield
  314.    STORE "11" TO item 
  315.    STORE   1  TO stackcount 
  316.    ? [      STORE line + 1 TO line]
  317.    LOCATE FOR Field:name = subfield
  318.    IF Field:type = "N"
  319.       ? [      @ line,2 SAY "** SUBTOTAL FOR "] +;
  320.         [+STR(lastrec,] + STR(Field:len,3) +;
  321.         [,] + STR(Field:dec,2) + [)+" **"]
  322.    ELSE
  323.       ? [      @ line,2 SAY ] +;
  324.         ["** SUBTOTAL FOR "+TRIM(lastrec)+" **"]
  325.    ENDIF
  326.    ? [      STORE line + 1 TO line]
  327.    DO WHILE stackcount < LEN(substack) 
  328.       IF item = $( substack, stackcount, 2 ) 
  329.          LOCATE FOR Field:name = $(&Mcontents)
  330.          IF .NOT. EOF
  331.             * ---Is a single field.
  332.             ? [      @ line,] + STR(col&item,3) +;
  333.               [ SAY STR(subtot&item,] +;
  334.               STR(&Mwidth,3) + [,] + STR(Field:dec,1) + [)]
  335.          ELSE
  336.             * ---Is an expression.
  337.             * ---Hard code DEC to 2.
  338.             ? [      @ line,] + STR(col&item,3) + [ SAY ] +;
  339.               [STR(subtot&item,] + STR(&Mwidth,3) + [,2)]
  340.          ENDIF
  341.          ? [      STORE 0 TO subtot&item]
  342.          STORE stackcount + 2 TO stackcount 
  343.       ENDIF 
  344.       STORE STR( VAL( item ) + 1, 2 ) TO item
  345.    ENDDO
  346.    ? [      STORE line + 2 TO line]
  347.    ? [      STORE ] + subfield + [ TO lastrec]
  348.    ? [   ENDIF]
  349. ENDIF
  350. *
  351. * ---Detail line section.
  352. ? [   *]
  353. ? [   * ---Print detail line.]
  354. STORE "11" TO item
  355. DO WHILE VAL(item) <= totalopts
  356.    STORE $(&Mcontents) TO string
  357.    STORE &Mwidth TO width
  358.    LOCATE FOR Field:name = string
  359.    IF .NOT. EOF
  360.       * ---The contents is a Field name.
  361.       IF Field:type="C"
  362.          * ---The field is a character type.
  363.          ? [   @ line,] + STR(col&item,3) + [ SAY ] +;
  364.            [$(] + string + [,1,] + STR(width,3) + [)]
  365.       ELSE
  366.          * ---The field is a numeric type.
  367.          ? [   @ line,] + STR(col&item,3) + [ SAY ] +;
  368.            [$(STR(] + string + [,] + STR(width,3) +;
  369.            [,] + STR(Field:dec,2) + [),1,] + STR(width,3) + [)]
  370.       ENDIF
  371.    ELSE
  372.       * ---The contents is an expression.
  373.       USE &datafile
  374.       IF 0 > TEST(&string)
  375.          * ---The expression is a numeric type.
  376.          * ---Hard code the LEN and DEC to 10,2.
  377.          ? [   @ line,] + STR(col&item,3) + [ SAY ] +;
  378.            [$(STR(] + string + [,10,2),1,] + STR(width,3) + [)]
  379.       ELSE
  380.          * ---The expression is a character type.
  381.          ? [   @ line,] + STR(col&item,3) + [ SAY ] +;
  382.            [$(] + string + [,1,] + STR(width,3) + [)]
  383.       ENDIF
  384.       * ---Reopen the STRUCTURE EXTENDED datafile.
  385.       USE &datafile..$$$
  386.    ENDIF
  387.    STORE STR( VAL( item ) + 1, 2 ) TO item
  388. ENDDO
  389. *
  390. * ---Accumulate totals and/or subtotals.
  391. ? [   STORE line + 1 TO line]
  392. IF istotal .AND. LEN(totstack) <> 1
  393.    ? [   *]
  394.    ? [   * ---Accumulate totals and/or subtotals.]
  395.    STORE "11" TO item
  396.    STORE 1 TO stackcount
  397.    DO WHILE stackcount < LEN(totstack)
  398.       IF item=$(totstack,stackcount,2)
  399.          ? [   STORE total&item+] + $(&Mcontents) +;
  400.            [ TO total&item]
  401.          STORE stackcount + 2 TO stackcount
  402.       ENDIF
  403.       STORE STR( VAL(item) + 1, 2 ) TO item
  404.    ENDDO
  405. ENDIF
  406. IF issubtotal .AND. LEN(substack) <> 1
  407.    STORE "11" TO item
  408.    STORE 1 TO stackcount
  409.    DO WHILE stackcount < LEN(substack)
  410.       IF item = $( substack, stackcount, 2 )
  411.          ? [   STORE subtot&item+] + $(&Mcontents) +;
  412.            [ TO subtot&item]
  413.          STORE stackcount + 2 TO stackcount
  414.       ENDIF
  415.       STORE STR( VAL(item) + 1, 2 ) TO item
  416.    ENDDO
  417. ENDIF
  418. ? [   SKIP]
  419. ? [ENDDO]
  420. *
  421. * ---Final subtotal and totals.
  422. IF issubtotal .AND. LEN(substack) <> 1
  423.    ? [*]
  424.    ? [* ---Print last subtotal record after end-of-file.]
  425.    ? [STORE line + 1 TO line]
  426.    LOCATE FOR Field:name = subfield
  427.    IF Field:type = "N"
  428.       ? [@ line,2 SAY "** SUBTOTAL FOR "] + [+STR(lastrec,] +;
  429.         STR(Field:len,3) + [,] + STR(Field:dec,2) + [)+" **"]
  430.    ELSE
  431.       ? [@ line,2 SAY "** SUBTOTAL FOR "+TRIM(lastrec)+" **"]
  432.    ENDIF
  433.    ? [STORE line + 1 TO line]
  434.    STORE "11" TO item 
  435.    STORE   1  TO stackcount 
  436.    DO WHILE stackcount < LEN(substack)
  437.       IF item = $( substack, stackcount, 2 )
  438.          STORE $(&Mcontents) TO string
  439.          LOCATE FOR Field:name = string
  440.          IF .NOT. EOF
  441.             * ---Is a single field.
  442.             ? [@ line,] + STR(col&item,3) +;
  443.               [ SAY STR(subtot&item,],&Mwidth,[,] +;
  444.               STR(Field:dec,1) + [)]
  445.          ELSE
  446.             * ---Is an expression.
  447.             * ---Hard code DEC to 2.
  448.             ? [@ line,] + STR(col&item,3) + [ SAY ] +;
  449.               [STR(subtot&item,],&Mwidth,[,2)]
  450.          ENDIF
  451.          STORE stackcount + 2 TO stackcount 
  452.       ENDIF 
  453.       STORE STR( VAL( item ) + 1, 2 ) TO item 
  454.    ENDDO 
  455. ENDIF
  456. IF istotal .AND. LEN(totstack) <> 1
  457.    ? [*]
  458.    ? [* ---Print final totals.]
  459.    STORE "11" TO item 
  460.    STORE 1 TO stackcount 
  461.    ? [STORE line + 2 TO line]
  462.    ? [@ line,2 SAY "*** FINAL TOTALS ***"]
  463.    ? [STORE line + 1 TO line]
  464.    DO WHILE stackcount < LEN(totstack) 
  465.       IF item = $( totstack, stackcount, 2 )
  466.          STORE $(&Mcontents) TO string
  467.          LOCATE FOR Field:name = string
  468.          IF .NOT. EOF
  469.             * ---Is a single field.
  470.             ? [@ line,] + STR(col&item,3) +;
  471.               [ SAY STR(total&item,],&Mwidth,[,] +;
  472.               STR(Field:dec,1) + [)]
  473.          ELSE
  474.             * ---Is an expression.
  475.             * ---Hard code DEC to 2.
  476.             ? [@ line,] + STR(col&item,3) +;
  477.               [ SAY STR(total&item,],&Mwidth,[,2)]
  478.          ENDIF 
  479.          STORE stackcount + 2 TO stackcount 
  480.       ENDIF 
  481.       STORE STR( VAL( item ) + 1, 2 ) TO item 
  482.    ENDDO 
  483. ENDIF
  484. *
  485. ? [@ line + 1, 0 SAY " "]
  486. ? [SET FORMAT TO SCREEN]
  487. ? [RELEASE ALL]
  488. ? [SET TALK ON]
  489. ? [SET BELL ON]
  490. ? [RETURN]
  491. ? [* EOF: ] + formfile
  492. ?
  493. SET ALTERNATE OFF
  494. SET ALTERNATE TO
  495. USE
  496. DELETE FILE &datafile..$$$
  497. CLEAR
  498. SET RAW OFF
  499. SET TALK ON
  500. RETURN
  501. * EOF: FORMGEN.PRG
  502.